home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol146 / xlisp.h < prev    next >
Encoding:
C/C++ Source or Header  |  1986-12-16  |  9.0 KB  |  336 lines
  1. /* xlisp - a small subset of lisp */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. /* system specific definitions */
  7. #define CI
  8.  
  9. #ifdef AZTEC
  10. #include "stdio.h"
  11. #include "setjmp.h"
  12. #else
  13. #include <stdio.h>
  14. #include <setjmp.h>
  15. #include <ctype.h>
  16. #endif
  17.  
  18. /* NNODES    number of nodes to allocate in each request (200) */
  19. /* TDEPTH    trace stack depth (100) */
  20. /* FORWARD    type of a forward declaration () */
  21. /* LOCAL    type of a local function (static) */
  22. /* AFMT        printf format for addresses ("%x") */
  23. /* FIXNUM    data type for fixed point numbers (long) */
  24. /* ITYPE    fixed point input conversion routine type (long atol()) */
  25. /* ICNV        fixed point input conversion routine (atol) */
  26. /* IFMT        printf format for fixed point numbers ("%ld") */
  27. /* FLONUM    data type for floating point numbers (float) */
  28. /* FTYPE    floating point input conversion routine type (double atof()) */
  29. /* FCNV        floating point input conversion routine (atof) */
  30. /* FFMT        printf format for floating point numbers ("%f") */
  31.  
  32. /* for the Eco-C C Compiler */
  33. #ifdef ECOC
  34. #undef TRUE
  35. #undef FALSE
  36. #define NNODES        1000
  37. #define TDEPTH        500
  38. #endif
  39.  
  40. /* for the Computer Innovations compiler */
  41. #ifdef CI
  42. #define NNODES        1000
  43. #define TDEPTH        500
  44. #define ITYPE        long atoi()
  45. #define ICNV(n)        atoi(n)
  46. #define NIL        0
  47. #endif
  48.  
  49. /* for the CPM68K compiler */
  50. #ifdef CPM68K
  51. #define NNODES        1000
  52. #define TDEPTH        500
  53. #define LOCAL
  54. #define AFMT        "%lx"
  55. #define FLONUM        double
  56. #undef NULL
  57. #define NULL        0L
  58. #endif
  59.  
  60. /* for the DeSmet compiler */
  61. #ifdef DESMET
  62. #define NNODES        1000
  63. #define TDEPTH        500
  64. #define LOCAL
  65. #define getc(fp)    getcx(fp)
  66. #define putc(ch,fp)    putcx(ch,fp)
  67. #define EOF        -1
  68. #endif
  69.  
  70. /* for the MegaMax compiler */
  71. #ifdef MEGAMAX
  72. #define NNODES        200
  73. #define TDEPTH        100
  74. #define TSTKSIZE    (4 * TDEPTH)
  75. #define LOCAL
  76. #define AFMT        "%lx"
  77. #define getc(fp)    macgetc(fp)
  78. #define putc(ch,fp)    macputc(ch,fp)
  79. #endif
  80.  
  81. /* for the VAX-11 C compiler */
  82. #ifdef vms
  83. #define NNODES        2000
  84. #define TDEPTH        1000
  85. #endif
  86.  
  87. /* for the DECUS C compiler */
  88. #ifdef decus
  89. #define NNODES        200
  90. #define TDEPTH        100
  91. #define FORWARD        extern
  92. #endif
  93.  
  94. /* for unix compilers */
  95. #ifdef unix
  96. #define NNODES        200
  97. #define TDEPTH        100
  98. #endif
  99.  
  100. /* for the AZTEC C compiler */
  101. #ifdef AZTEC
  102. #define NNODES        200
  103. #define TDEPTH        100
  104. #define FLONUM        double
  105. #define getc(fp)    agetc(fp)
  106. #define putc(ch,fp)    aputc(ch,fp)
  107. #endif
  108.  
  109. /* default important definitions */
  110. #ifndef NNODES
  111. #define NNODES        200
  112. #endif
  113. #ifndef TDEPTH
  114. #define TDEPTH        100
  115. #endif
  116. #ifndef FORWARD
  117. #define FORWARD
  118. #endif
  119. #ifndef LOCAL
  120. #define LOCAL        static
  121. #endif
  122. #ifndef AFMT
  123. #define AFMT        "%x"
  124. #endif
  125. #ifndef FIXNUM
  126. #define FIXNUM        long
  127. #endif
  128. #ifndef ITYPE
  129. #define ITYPE        long atol()
  130. #endif
  131. #ifndef ICNV
  132. #define ICNV(n)        atol(n)
  133. #endif
  134. #ifndef IFMT
  135. #define IFMT        "%ld"
  136. #endif
  137. #ifndef FLONUM
  138. #define FLONUM        float
  139. #endif
  140. #ifndef FTYPE
  141. #define FTYPE        double atof()
  142. #endif
  143. #ifndef FCNV
  144. #define FCNV(n)        atof(n)
  145. #endif
  146. #ifndef FFMT
  147. #define FFMT        "%f"
  148. #endif
  149. #ifndef TSTKSIZE
  150. #define TSTKSIZE    (sizeof(NODE *) * TDEPTH)
  151. #endif
  152.  
  153. /* useful definitions */
  154. #define TRUE    1
  155. #define FALSE    0
  156. #ifndef NIL
  157. #define NIL    (NODE *)0
  158. #endif
  159.  
  160. /* absolute value macros */
  161. #define abs(n)    ((n) < 0 ? -(n) : (n))
  162. #define fabs(n)    ((n) < 0.0 ? -(n) : (n))
  163.  
  164. /* program limits */
  165. #define STRMAX        100        /* maximum length of a string constant */
  166.     
  167. /* node types */
  168. #define FREE    0
  169. #define SUBR    1
  170. #define FSUBR    2
  171. #define LIST    3
  172. #define SYM    4
  173. #define INT    5
  174. #define STR    6
  175. #define OBJ    7
  176. #define FPTR    8
  177. #define FLOAT    9
  178.  
  179. /* node flags */
  180. #define MARK    1
  181. #define LEFT    2
  182.  
  183. /* string types */
  184. #define DYNAMIC    0
  185. #define STATIC    1
  186.  
  187. /* new node access macros */
  188. #define ntype(x)    ((x)->n_type)
  189. #define atom(x)        ((x) == NIL || (x)->n_type != LIST)
  190. #define null(x)        ((x) == NIL)
  191. #define listp(x)    ((x) == NIL || (x)->n_type == LIST)
  192. #define consp(x)    ((x) && (x)->n_type == LIST)
  193. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  194. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  195. #define stringp(x)    ((x) && (x)->n_type == STR)
  196. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  197. #define filep(x)    ((x) && (x)->n_type == FPTR)
  198. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  199. #define fixp(x)        ((x) && (x)->n_type == INT)
  200. #define floatp(x)    ((x) && (x)->n_type == FLOAT)
  201. #define car(x)        ((x)->n_car)
  202. #define cdr(x)        ((x)->n_cdr)
  203. #define rplaca(x,y)    ((x)->n_car = (y))
  204. #define rplacd(x,y)    ((x)->n_cdr = (y))
  205. #define getvalue(x)    ((x)->n_symvalue)
  206. #define setvalue(x,v)    ((x)->n_symvalue = (v))
  207.  
  208. /* symbol node */
  209. #define n_symplist    n_info.n_xsym.xsy_plist
  210. #define n_symvalue    n_info.n_xsym.xsy_value
  211.  
  212. /* subr/fsubr node */
  213. #define n_subr        n_info.n_xsubr.xsu_subr
  214.  
  215. /* list node */
  216. #define n_car        n_info.n_xlist.xl_car
  217. #define n_cdr        n_info.n_xlist.xl_cdr
  218. #define n_ptr        n_info.n_xlist.xl_car
  219.  
  220. /* integer node */
  221. #define n_int        n_info.n_xint.xi_int
  222.  
  223. /* float node */
  224. #define n_float        n_info.n_xfloat.xf_float
  225.  
  226. /* string node */
  227. #define n_str        n_info.n_xstr.xst_str
  228. #define n_strtype    n_info.n_xstr.xst_type
  229.  
  230. /* object node */
  231. #define n_obclass    n_info.n_xobj.xo_obclass
  232. #define n_obdata    n_info.n_xobj.xo_obdata
  233.  
  234. /* file pointer node */
  235. #define n_fp        n_info.n_xfptr.xf_fp
  236. #define n_savech    n_info.n_xfptr.xf_savech
  237.  
  238. /* node structure */
  239. typedef struct node {
  240.     char n_type;        /* type of node */
  241.     char n_flags;        /* flag bits */
  242.     union {            /* value */
  243.     struct xsym {        /* symbol node */
  244.         struct node *xsy_plist;    /* symbol plist - (name . plist) */
  245.         struct node *xsy_value;    /* the current value */
  246.     } n_xsym;
  247.     struct xsubr {        /* subr/fsubr node */
  248.         struct node *(*xsu_subr)();    /* pointer to an internal routine */
  249.     } n_xsubr;
  250.     struct xlist {        /* list node (cons) */
  251.         struct node *xl_car;    /* the car pointer */
  252.         struct node *xl_cdr;    /* the cdr pointer */
  253.     } n_xlist;
  254.     struct xint {        /* integer node */
  255.         FIXNUM xi_int;        /* integer value */
  256.     } n_xint;
  257.     struct xfloat {        /* float node */
  258.         FLONUM xf_float;        /* float value */
  259.     } n_xfloat;
  260.     struct xstr {        /* string node */
  261.         int xst_type;        /* string type */
  262.         char *xst_str;        /* string pointer */
  263.     } n_xstr;
  264.     struct xobj {        /* object node */
  265.         struct node *xo_obclass;    /* class of object */
  266.         struct node *xo_obdata;    /* instance data */
  267.     } n_xobj;
  268.     struct xfptr {        /* file pointer node */
  269.         FILE *xf_fp;        /* the file pointer */
  270.         int xf_savech;        /* lookahead character for input files */
  271.     } n_xfptr;
  272.     } n_info;
  273. } NODE;
  274.  
  275. /* execution context flags */
  276. #define CF_GO        1
  277. #define CF_RETURN    2
  278. #define CF_THROW    4
  279. #define CF_ERROR    8
  280. #define CF_CLEANUP    16
  281. #define CF_CONTINUE    32
  282.  
  283. /* execution context */
  284. typedef struct context {
  285.     int c_flags;            /* context type flags */
  286.     struct node *c_expr;        /* expression (type dependant) */
  287.     jmp_buf c_jmpbuf;            /* longjmp context */
  288.     struct context *c_xlcontext;    /* old value of xlcontext */
  289.     struct node *c_xlstack;        /* old value of xlstack */
  290.     struct node *c_xlenv;        /* old value of xlenv */
  291.     int c_xltrace;            /* old value of xltrace */
  292. } CONTEXT;
  293.  
  294. /* function table entry structure */
  295. struct fdef {
  296.     char *f_name;            /* function name */
  297.     int f_type;                /* function type SUBR/FSUBR */
  298.     struct node *(*f_fcn)();        /* function code */
  299. };
  300.  
  301. /* memory segment structure definition */
  302. struct segment {
  303.     int sg_size;
  304.     struct segment *sg_next;
  305.     struct node sg_nodes[1];
  306. };
  307.  
  308. /* external procedure declarations */
  309. extern struct node *xleval();        /* evaluate an expression */
  310. extern struct node *xlapply();        /* apply a function to arguments */
  311. extern struct node *xlevlist();        /* evaluate a list of arguments */
  312. extern struct node *xlarg();        /* fetch an argument */
  313. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  314. extern struct node *xlmatch();        /* fetch an typed argument */
  315. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  316. extern struct node *xlgetfile();    /* fetch a file/stream argument */
  317. extern struct node *xlsend();        /* send a message to an object */
  318. extern struct node *xlenter();        /* enter a symbol */
  319. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  320. extern struct node *xlmakesym();    /* make an uninterned symbol */
  321. extern struct node *xlsave();        /* generate a stack frame */
  322. extern struct node *xlframe();        /* establish a new environment frame */
  323. extern struct node *xlgetvalue();    /* get value of a symbol (checked) */
  324. extern struct node *xlxgetvalue();    /* get value of a symbol */
  325. extern struct node *xlygetvalue();    /* get value of a symbol (no ivars) */
  326.  
  327. extern struct node *cvfixnum();        /* convert a fixnum */
  328. extern struct node *cvflonum();        /* convert a flonum */
  329.  
  330. extern struct node *xlgetprop();    /* get the value of a property */
  331. extern char *xlsymname();        /* get the print name of a symbol */
  332.  
  333. extern struct node *newnode();        /* allocate a new node */
  334. extern char *stralloc();        /* allocate string space */
  335. extern char *strsave();            /* make a safe copy of a string */
  336.